home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / PROGTOOL / EUPHOR10.ZIP;1 / WEAPONS.E < prev    next >
Encoding:
Text File  |  1993-06-09  |  5.9 KB  |  265 lines
  1. -- weapons.e
  2. -- phasors, torpedos, (antimatter pods - coming soon)
  3.  
  4. global constant W_PHASOR = 1,
  5.         W_TORPEDO = 2,
  6.         W_POD = 3
  7.  
  8. type weapon_system(integer x)
  9.     return find(x, {W_PHASOR, W_TORPEDO, W_POD})
  10. end type
  11.  
  12. extended_h_coord x0
  13. extended_v_coord y0
  14. atom xinc
  15. atom yinc
  16.  
  17. function diftype(valid_f_row shooter, valid_f_row victim)
  18. -- return TRUE if shooter and victim are on opposing sides
  19.  
  20.     if f[shooter][F_TYPE] = G_BS then
  21.     return victim != ENTERPRISE
  22.     else
  23.     if find(f[shooter][F_TYPE], {G_SK, G_BK, G_JM}) and
  24.        find(f[victim][F_TYPE] , {G_SK, G_BK, G_JM}) then
  25.         -- both Klingons
  26.         return FALSE
  27.     else
  28.         return f[shooter][F_TYPE] != f[victim][F_TYPE]
  29.     end if
  30.     end if
  31. end function
  32.  
  33. without warning
  34. procedure pod_effect(h_coord rx,v_coord ry)
  35. -- detonate an antimatter pod, all objects in the quadrant are
  36. -- affected. It's like a 1500 unit tholian phasor blast against
  37. -- everyone
  38. end procedure
  39. with warning
  40.  
  41. global procedure weapon(weapon_system w, positive_atom strength)
  42. -- fire a phasor, torpedo or pod from shooter starting from (x0,y0) and
  43. -- proceeding in steps of xinc, yinc until something is hit or the
  44. -- edge of the screen is reached
  45.  
  46.     extended_h_coord x
  47.     extended_v_coord y
  48.     h_coord rx
  49.     v_coord ry
  50.     extended_h_coord prev_rx
  51.     extended_v_coord prev_ry
  52.     boolean ahit
  53.     char c
  54.     positive_int freq
  55.     positive_atom units
  56.     sequence under
  57.  
  58.     prev_rx = 0
  59.     prev_ry = 0
  60.     x = x0
  61.     y = y0
  62.     ahit = FALSE
  63.     under = {}
  64.     if w != W_PHASOR then
  65.     freq = 3500
  66.     sound(freq)
  67.     end if
  68.     while x >= .5 and x < HSIZE + 0.5 and
  69.       y >= .5 and y < VSIZE + 0.5 do
  70.     rx = floor(x + 0.5)
  71.     ry = floor(y + 0.5)
  72.     if rx != prev_rx or ry != prev_ry then
  73.         c = read_screen(rx, ry)
  74.         if c = ' ' or c = STAR or w = W_POD then
  75.         prev_rx = rx
  76.         prev_ry = ry
  77.         if w = W_PHASOR then
  78.             under = prepend(under, {rx, ry, c})
  79.             write_screen(rx, ry, '*')
  80.             delay(0.006)
  81.         else
  82.             if length(under) != 0 then
  83.             write_screen(under[1][1], under[1][2], under[1][3])
  84.             end if
  85.             under = {{rx, ry, c}}
  86.             if w = W_TORPEDO then
  87.             write_screen(rx, ry, '*')
  88.             else
  89.             write_screen(rx, ry, '@')
  90.             if get_key() = 13 then
  91.                 exit
  92.             end if
  93.             end if
  94.             sound(freq)
  95.             if freq > 600 then
  96.             freq = freq - 50
  97.             end if
  98.             delay(0.008)
  99.         end if
  100.         else
  101.         ahit = TRUE
  102.         exit
  103.         end if
  104.     end if
  105.     x = x + xinc
  106.     y = y + yinc
  107.     end while
  108.  
  109.     if w != W_PHASOR then
  110.     sound(0)
  111.     end if
  112.     if w = W_POD then
  113.     pod_effect(rx, ry)
  114.     else
  115.     if ahit then
  116.         victim = flook(rx, ry, FALSE)
  117.         if diftype(shooter, victim) then
  118.         if w = W_TORPEDO then
  119.             sounde(1, 85, 1)
  120.             torpedo_sound()
  121.             dodmg(strength, TRUE)
  122.         else
  123.             units = bcalc(strength)
  124.             phasor_sound(units)
  125.             dodmg(units, FALSE)
  126.         end if
  127.         end if
  128.     end if
  129.     end if
  130.     for i = length(under) to 1 by - 1 do
  131.     write_screen(under[i][1], under[i][2], under[i][3])
  132.     end for
  133. end procedure
  134.  
  135. type object_height(integer x)
  136.     return x >= 1 and x <= 3
  137. end type
  138.  
  139. global procedure tholian_phasor(positive_atom pen)
  140. -- perform tholian phasor: no phasor drawn, can't miss
  141.  
  142.     positive_atom blast
  143.     h_coord targx
  144.     v_coord targy
  145.     sequence c
  146.     positive_int len
  147.     object_type t
  148.     object_height height
  149.  
  150.     victim = f[shooter][F_TARG]
  151.     targx = f[victim][F_X]
  152.     targy = f[victim][F_Y]
  153.     t = f[victim][F_TYPE]
  154.     if victim = ENTERPRISE then
  155.     len = length(esym)
  156.     height = 1
  157.     elsif t = G_BS then
  158.     len = length(BASE)
  159.     height = 2
  160.     elsif t = G_PL then
  161.     len = length(PLANET_MIDDLE)
  162.     height = 3
  163.     else
  164.     len = length(ship[f[victim][F_TYPE]][1])
  165.     height = 1
  166.     end if
  167.     blast = bcalc(pen)
  168.     for i = -2 to blast / 300 do
  169.     sound(500 + 500 * (integer(i / 2)))
  170.     write_screen(f[shooter][F_X]+1, f[shooter][F_Y], '-')
  171.     for j = 0 to height - 1 do
  172.         c = read_screen({targx, len}, targy + j)
  173.         write_screen(targx, targy + j, repeat(' ', len))
  174.     end for
  175.     delay(0.07)
  176.     write_screen(f[shooter][F_X]+1, f[shooter][F_Y], '+')
  177.     for j = 0 to height - 1 do
  178.         write_screen(targx, targy + j, c)
  179.     end for
  180.     delay(0.07)
  181.     end for
  182.     sound(0)
  183.     dodmg(blast, FALSE)
  184. end procedure
  185.  
  186. global procedure setpt(valid_f_row r)
  187. -- set up enemy (or base) phasor or torpedo
  188.  
  189.     positive_atom dist
  190.     valid_f_row targ
  191.     h_coord targx
  192.     v_coord targy
  193.     object_type t
  194.  
  195.     x0 = f[r][F_X]
  196.     y0 = f[r][F_Y]
  197.     targ = f[r][F_TARG]
  198.     targx = f[targ][F_X]
  199.     targy = f[targ][F_Y]
  200.     t = f[r][F_TYPE]
  201.  
  202.     -- decide which side to shoot from
  203.     if t = G_BS then
  204.     if x0 < targx then
  205.         x0 = x0 + length(BASE)
  206.     else
  207.         x0 = x0 - 1
  208.     end if
  209.     if y0 < targy then
  210.         y0 = y0 + 2
  211.     else
  212.         y0 = y0 - 1
  213.     end if
  214.     else
  215.     if x0 < targx  then
  216.         x0 = x0 + length(ship[t][1])
  217.     else
  218.         x0 = x0 - 1
  219.     end if
  220.     end if
  221.  
  222.     -- add a bit of randomness so they might miss
  223.     xinc = targx - x0 + rand(5) - 3
  224.     yinc = targy - y0 + rand(3) - 2
  225.     if xinc = 0 and yinc = 0 then
  226.     xinc = 1 -- prevent infinite loop
  227.     end if
  228.     dist = sqrt(1 + xinc * xinc + yinc * yinc)
  229.     xinc = xinc/dist
  230.     yinc = yinc/dist
  231. end procedure
  232.  
  233. global type direction(atom x)
  234.     return x >= 0 and x < 10
  235. end type
  236.  
  237. constant PI = 3.14159265
  238.  
  239. type angle(atom x)
  240.     return x >= 0 and x < 2.25 * PI
  241. end type
  242.  
  243. global procedure esetpt(direction dir)
  244. -- set up for enterprise phasor/torpedo/pod firing
  245.  
  246.     angle theta
  247.  
  248.     shooter = ENTERPRISE
  249.     x0 = f[ENTERPRISE][F_X]
  250.     y0 = f[ENTERPRISE][F_Y]
  251.     theta = (dir - 1)/8.0 * 2 * PI
  252.     xinc = cos(theta)
  253.     yinc = -sin(theta) / ASPECT_RATIO
  254.     if xinc < -0.00001 then
  255.     write_screen(x0, y0, esyml)
  256.     elsif xinc > 0.00001 then
  257.     write_screen(x0, y0, esymr)
  258.     end if
  259.     if read_screen(x0, y0) = esyml[1] then
  260.     x0 = x0 - 1
  261.     else
  262.     x0 = x0 + length(esym)
  263.     end if
  264. end procedure
  265.